COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	begin "undoc" comment This is an experimental program that removes structured
C00014 00003	Basic declarations and basic procedures
C00021 00004	Lookup procedures
C00027 00005	Outline of the finite-state scanner
C00036 00006	Phase 1
C00046 00007	Phase 2
C00049 ENDMK
C⊗;
begin "undoc" comment This is an experimental program that removes structured
"top-down" documentation so that conventional compilers will understand the code.
The structured documentation has a canned format something like de Marneffe's
"Holon programming", and it seems to be a successful way to communicate algorithms.

Here are the rules for input in the canned format: Let <CR> stand for carriage-
return, <LF> for line-feed, <FF> for form-feed, <SP> for space, and <TB> for tab.
As usual, each "line" of the input file ends with a carriage-return and line-feed,
<CR>LF>, and each "page" ends with <FF> following some line. The UNDOC program
does special things when it sees the characters { and }, which should be
balanced like parentheses. Characters of the input file that appear between matching
{ and } are called "titles", for want of a better name, and the other characters are
called nontitles. Titles are further classified as follows:

(1) Titles beginning with "{{". These should end with "}}". They are called
comments, and are simply ignored, removed from the input. (Another program, TEXDOC,
makes use of such comments when preparing "pretty printed" output from the same
input used by UNDOC.) Example: {{ This is a {\sl comment}. }}

(2) Titles beginning with one brace but not with two consecutive braces. All <SP>
and <TB> and <CR> characters between the opening { and the matching } are
treated as equivalent to <SP>, all <LF> characters are ignored, no <FF> characters
are allowed, two or more consecutive <SP> characters are replaced by a single <SP>,
an <SP> just after the opening { or just before the closing } is deleted, and
<SP>s or <TB>s after the closing right brace are also deleted. These titles
stand for source text that will be copied in line from the "definition" of the
title to each "use" of the title. In fact, this is the main purpose of UNDOC,
to rearrange the input file by replacing descriptive titles by their corresponding
definitions. In some ways this extends the macro facility of some compilers
(because titles can be long and explanatory and their definitions can follow
their use), and in other ways it is more primitive (because titles cannot have
parameters). Each non-comment title must be defined, and there are four kinds
of definition:

(2a) Title followed by "=<definition><CR><LF><CR><LF>" or by
"=<definition><CR><LF><FF>". (In other words, a title followed by an equal sign
and then by some more text that is terminated either by a blank line or by the
end of a page.) The text of a <definition> is any sequence of characters, except
that braces must be properly nested. Definitions may contain uses of other
titles, but they should not contain further definitions. The meaning of such
a definition is that the title is to be replaced by the <definition> wherever
else it appears in the input file. Example:					;"
{ Initialize the tables } = <CR><LF>
for i := 1 to n do<CR><LF>
<TB>begin { Set $A[i]$ to initial value };<CR><LF>
<TB>{ Set $B[i]$ to initial value };<CR><LF>
<TB>end<CR><LF>
<CR><LF>									"
comment The characters <SP>, <CR>, <LF>, and <TB> are ignored at the very beginning
of a definition, but not elsewhere within it. Thus, the actual definition in this
example begins with "for i " and ends with "<TB>end".

(2b) Title followed by "+=<definition><CR><LF><CR><LF>" or by
"+=<definition><CR><LF><FF>". This is the same as (2a), except that the
definition is appended to the previous definition of the title, if any. Example: ;"
{Initializations} += {Initialize the tables};<CR><LF><FF>			"
comment Using this technique one can specify different parts of the
{ Initializations } in different places.

(2c) Title followed by "#=<definition><CR><LF><CR><LF>" or by
"#=<definition><CR><LF><FF>". This is the same as (2a) except that the title
should be a single identifier, and it must precede all of its uses.
When it is used it is not enclosed in braces, and it must be followed by a
parameter in parentheses. The parameter is substituted for all occurrences
of # in the definition. Example:
{ width } #= mem[#+2].rl<CR><LF><CR><LF>
{ succ } #= mem[#+3].int<CR><LF><CR><LF>
after which "width(succ(p))" would expand to "mem[mem[p+3].int+2].rl".

(2d) Title followed by "-=<definition><CR><LF><CR><LF>" or by
"-=<definition><CR><LF><FF>". This is the same as (2a) except that the title
should be a single identifier, and it must precede all of its uses.
Like (2c), it is not enclosed in braces when used.
Example: { tracing } -= eqtb[hashsize+texpars+15]<CR><LF><CR><LF>
gives a short name to a longer construct.

(2e) Title followed by ":=<constant>". Here the constant is a nonnegative integer,
possibly preceded by "'" (denoting octal notation) and/or <SP> or <TB> characters.
The title itself should be a single identifer, namely a letter followed by zero
or more letters and/or digits, where "_" counts as a letter. This is called a
constant identifier. Uses of the identifier are not enclosed in braces, the
identifier itself will be replaced by the constant in decimal notation wherever
it appears in nontitles. Example: { form_feed } := '14

UNDOC will do limited arithmetic on constant identifiers. (In fact, constant
identifiers are needed primarily because PASCAL doesn't do compile-time
arithmetic on constants, secondarily because of PASCAL's insistence that
labels be numeric.) If the use of a constant title is immediately followed by
"+<constant>" or "-<constant>", the addition or subtraction will be performed
before replacement. Constant identifers themselves are also allowed as <constant>s,
in ordinary text as well as in constant definitions. For example, the definition
"{ carriage_return } := form_feed+1" would define the constant identifier
"carriage_return" to be one greater than the previously-defined value of
"form_feed", namely 13 (in decimal notation).

Since titles of types (2a) and (2b) tend to be rather long and wordy, a special
feature is included to save typing: Such titles may be abbreviated by
terminating the name with "..." after enough initial characters have been
given to identify the title uniquely. Example: {Set $A[i]$ ... }.
A title must, however, be given in full before it appears in abbreviated form.
And the abbreviation can't be used if it causes left braces to be unmatched.

Errors detected by UNDOC are reported to the user and simultaneously written
on file ERRORS.TMP. The user is prompted for the names of his input and
output files.

UNDOC does its job in two phases: First it reads the entire source file into
main memory, translating it into a sequence of "instructions" of the following
forms:
	output string number k
	insert the equivalent of title number k
	end an insertion
	go to instruction number k
	begin to remember a parameter for the next macro title
	insert the current parameter here
This is done by using a finite-state control, branching to one of many
possibilities based on the current state and current character. The second phase
simply executes the instructions formed during the first phase.
;
comment Basic declarations and basic procedures;

require "⊂⊃⊂⊃" delimiters; "used for macros"
define # = ⊂;comment⊃; "used henceforth instead of quoted comments like this"
define nextline = ⊂('15&'12)⊃ # carriage-return and line-feed in print commands;
define thru = ⊂step 1 until⊃ # abbreviation for for clauses;
define DEBUGONLY = ⊂comment⊃ # changed to ⊂⊃ when debugging;
define saf = ⊂safe⊃ # used when an array is believed to require no bounds checks;
DEBUGONLY redefine saf = ⊂⊃ # when debugging, belief turns to disbelief;
DEBUGONLY external procedure bail # the SAIL debugger in case of need;

label phase2 # go here when phase 1 is finished;
label finalend # go here when phase 2 is finished;

integer ichan,ochan,brchar,eof,lineno,pageno # standard variables of input system;
string filename,inputfile,outputfile # variables relating to file names;
string saf array fn[0:2] # components of file name;
procedure scanfilename # parses filename, puts parts in the fn array;
begin integer t # (0,1,2) for (name,ext,ppn);
string s # temporary storage;
integer c # current character of string;
s←filename; t←0; fn[0]←fn[1]←fn[2]←"";
while (c←lop(s)) do
	begin if c="." then t←1 else if c="[" then t←2;
	fn[t]←fn[t]&c;
	end;
end;

procedure initio # initialize input and output;
begin while true do
	begin print("Input file: "); filename←inchwl; scanfilename;
	if fn[1]=0 then fn[1]←".DOC";
	inputfile←fn[0]&fn[1]&fn[2];
	open(ichan←getchan,"DSK",0,19,0,100,brchar,eof);
	lookup(ichan,inputfile,eof);
	if not eof then done;
	print("Lookup failed on file ",inputfile,"!",nextline);
	release(ichan);
	end;
while true do
	begin fn[1]←".PAS";
	outputfile←fn[0]&fn[1]&fn[2];
	print("Output file (default = ",outputfile,"): ");
	filename←inchwl;
	if filename then
		begin scanfilename;
		outputfile←fn[0]&fn[1]&fn[2];
		end;
	open(ochan←getchan,"DSK",0,0,19,0,0,eof);
	enter(ochan,outputfile,eof);
	if not eof then done;
	print("Can't write on file ",outputfile,"!",nextline);
	release(ochan);
	filename←inputfile; scanfilename;
	end;
setprint("errors.tmp","B") # output goes to file as well as to user terminal;
setbreak(1,'14,null,"INA") # input(ichan,1) will read up to and including <FF>;
end;

procedure error(string s) # prints a message to report an anomaly;
print(nextline,"p.",pageno,",l.",lineno,": ",s);
procedure overflow(string s) # prints error message and aborts phase 1;
begin error("Capacity exceeded ("); print(s,"), some input is lost.");
go to phase2;
end;
procedure overflow2(string s) # prints error message and dies;
begin print(nextline,"Capacity exceeded in phase 2 (",s,"), must quit.");
go to finalend;
end;

define instrsize = 2500 # number of instructions allowed;
integer saf array instr[0:instrsize] # the compiled "instructions";
define opc(m) = ⊂(instr[m] lsh -18)⊃ # op-code of instruction number m;
define addr(m) = ⊂(instr[m] land '777777)⊃ # address of instruction number m;
define txt=1, jmp=2, call=3, exit=4, begpar=5, inspar=6 # allowable op codes;
integer m # the current instruction;
integer lastm # the final instruction;
integer stack # pointer to top of subroutine stack in phase 2;
procedure compile(integer op,adr) # used to store the next "instruction";
if m≥instrsize then overflow("instrsize")
else	begin instr[m]←(op lsh 18)+adr; m←m+1;
	end;

define txtsize=5000 # number of text strings;
string saf array texts[0:txtsize] # nontitle texts;
integer txtptr # the number of stored texts;

define parsize=5 # number of simultaneous parameters;
string saf array par,ppar[0:parsize] # parameters and partial parameters in phase 2;
integer parptr, pparptr # pointers to top of parameters stacks;
integer saf array caller,level[0:parsize] # for parameters in phase1;

integer curlev # count of ('s minus )'s, used to tell if a parameter has ended
	(namely if curlev=level[parptr]) in phase 1;
integer tlineno # line number where current title began;
comment Lookup procedures;

comment Titles are stored in two conventional binary search trees, whose
nodes contain the following fields:
	str[k], the title stored at node k (a string) followed by "}",
	left[k], left son of node k,
	right[k], right son of node k,
	eq[k], the defined equivalent of node k.
Constant and macro titles appear in a tree whose root is conroot, other titles
appear in a tree whose root is titlroot. The value eq[k] for constants is
an integer constant. For other titles it is either 0 (undefined) or positive (the
index of the first instruction of the definition) or negative (the negative of
the first instruction of the macro taking a parameter).
;
define strsize=1000 # number of different titles allowed;
string saf array str[1:strsize] # title names;
integer saf array left,right,eq[0:strsize] # sons and equivalents;
integer nstrs # number of nodes in the tree;
integer titlroot,conroot # roots of trees;

integer procedure findabbr(string x) # looks for an abbreviated title;
begin comment If x is not the abbreviation of a unique title, an error
message is given and 0 is returned. Otherwise the index k such that x is a
prefix of str[k] is returned;
label ambig # go here if there's more than one match;
label errorprint # go here to complete the error message;
string xx # x with the closing "..." removed;
xx←x[1 to ∞-3];
if xx[∞ to ∞] = " " then xx←xx[1 to ∞-1];
if titlroot then
	begin integer k # current node;
	integer l # the length of xx;
	k←titlroot; l←length(xx);
	while true do
		begin string s,t; integer d;
		if equ(xx,str[k][1 to l]) then
			begin integer p;
			if (p←left[k]) then
				begin while right[p] do p←right[p];
				if equ(xx,str[p][1 to l]) then go to ambig;
				end;
			if (p←right[k]) then
				begin while left[p] do p←left[p];
				if equ(xx,str[p][1 to l]) then go to ambig;
				end;
			return(k);
			end;
		s←xx; t←str[k];
		while (d←lop(s)-lop(t))=0 do;
		if d<0 then k←left[k] else k←right[k];
		if k=0 then done;
		end;
	end;
error("Unmatched"); go to errorprint;
ambig: error("Ambiguous");
errorprint: print(" abbreviation: {",x,"}."); return(0);
end;

integer procedure find(string x; integer mode) # looks for the title name x;
begin comment If mode=0, this procedure finds x in the title tree, inserting
x if x wasn't already present. If mode=1, this procedure similarly finds x in
the constant tree. If mode=2, this procedure looks for x in the constant tree,
but doesn't insert it. The value returned is the node where x was found, or 0
if it wasn't;
integer k # current node;
integer link # pointer to new node if insertion needs to be done;
string xx # x with a right brace after it;
xx←x&"}";
case mode of begin
[0] begin if equ(x[∞-2 to ∞],"...") then return(findabbr(x));
	k←titlroot; link←nstrs+1 end;
[1] begin k←conroot; link←nstrs+1 end;
[2] begin k←conroot; link←0 end
  end;
if k=0 then
	if mode then conroot←link else titlroot←link
else while true do
	begin string s,t; integer d;
	if equ(xx,str[k]) then return(k);
	s←xx; t←str[k];
	while (d←lop(s)-lop(t))=0 do;
	comment No string will be a prefix of another since they end with "}";
	if d<0 then
		if left[k] then k←left[k]
		else	begin left[k]←link; done;
			end
	else	if right[k] then k←right[k]
		else	begin right[k]←link; done;
			end;
	end;
if link then
	begin if link≥strsize then overflow("strsize");
	str[nstrs←link]←xx; eq[nstrs]←left[nstrs]←right[nstrs]←0;
	end;
return(link);
end;

comment Outline of the finite-state scanner;

comment Here are the different types of character codes distinguished:;
define space=0 # space or tab;
define lf=1 # line-feed;
define cr=2 # carriage-return;
define ff=3 # form-feed;
define letter=4 # A...Z or a...z or _;
define digit=5 # 0...9;
define apost=6 # ';
define plus=7 # +;
define minus=8 # -;
define colon=9 # :;
define equals=10 # =;
define lbrace=11 # {;
define rbrace=12 # };
define lpren=13 # (;
define rpren=14 # );
define hash=15 # #;
define other=16 # none of the above;
define charcodes=other+1 # the number of different character types recognized;
preload_with [8] other,
	other, space, lf, other, ff, cr, [2] other,
	[8] other,
	letter, [7] other,
	space, [2] other, hash, [3] other, apost,
	lpren, rpren, other, plus, other, minus, [2] other,
	[8] digit,
	[2] digit, colon, [2] other, equals, [2] other,
	other, [7] letter,
	[16] letter,
	[3] letter, [5] other,
	other, [7] letter,
	[16] letter,
	[3] letter, lbrace, [2] other, rbrace, other;
integer saf array chartype[0:'177];

comment The state of the scanner appears in variable "state" and also in
a few other variables;
integer state # the scanner state;
integer c # the current character;
string id # current identifier being scanned;
integer defplace # current constant;
integer op # pending operator on constant;
integer accum # current value of constant;
integer bal # excess of {'s over }'s;
integer lastc # previous character (maintained only when scanning comments);
integer deftype # type of title definition;
integer curdef # location of instruction preceding the current definition,
	or -1 if no definition is in progress;
integer radix # 8 or 10 when scanning constants;
integer val # current value of identifier or constant being scanned;

string inbuf # the input buffer (up to 100 characters);
string texte # the current string being compressed from the input;

comment The scanner states have the following significance:
	normal, outside of titles when nothing special is active.
	normal1, like normal but immediately following a line-feed.
	title1, just after scanning the opening { of a title.
	title2, scanning during the middle of a title.
	title3, just after scanning the closing } of a title.
	skipspaces, scanning titles when spaces are ignored.
	skipcomment, scanning comment titles.
	skipcr, skipping spaces and carriage-returns at beginning of a definition.
	ident, scanning an identifier.
	const, beginning of a constant.
	const1, after a constant has begun.
During states ident, const, and const1, the value of op is 0 if there's no
operation pending, otherwise op is "+" or "-" and accum contains the value of
the current constant before the pending operation. Also defplace is 0 if the
current constant is not in a definition, otherwise it is the location of the
constant identifier being defined;

define normal=0, normal1=normal+charcodes, title1=normal1+charcodes,
title2=title1+charcodes, title3=title2+charcodes, skipspaces=title3+charcodes,
skipcomment=skipspaces+charcodes, skipcr=skipcomment+charcodes,
ident=skipcr+charcodes, const=ident+charcodes, const1=const+charcodes;

comment The following procedures do some of the most important operations
needed during the scanning process;

procedure storetext # call this when texte needs to be stored;
begin texts[txtptr]←texte; texte←"";
compile(txt,txtptr); 
if txtptr≥txtsize then overflow(txtsize);
txtptr←txtptr+1;
end;

procedure startdef # call this when a definition is beginning;
begin if curdef≥0 then
	begin error("Definition within a definition.");
	state←skipcr;
	end
else if deftype<2 then
	begin comment Non-constant definition;
	defplace←find(texte,0); state←skipcr; curdef←m;
	m←m+1 # leave room for a jmp instruction to be inserted later;
	if defplace=0 or eq[defplace]=0 then eq[defplace]←m
	else	begin comment Appending to a definition; integer j; j←eq[defplace]-1;
		if deftype=0 then error("Double definition of {"&str[defplace]&".");
		do j←addr(j)-1 until opc(j)=exit # find end of current definition;
		instr[j]←(jmp lsh 18)+m;
		end;
	end
else	begin comment Constant or macro definition; defplace←find(texte,1);
	if eq[defplace] then error("Double definition of {"&str[defplace]&".");
	if deftype=2 then
		begin op←0; state←const; radix←10;
		end
	else	begin state←skipcr; curdef←m; m←m+1; eq[defplace]←-m;
		end;
	end;
texte←"";
end;

procedure finishdef # call this when a definition has ended;
if curdef≥0 then
	begin if texte then storetext;
	compile(exit,0); instr[curdef]←(jmp lsh 18)+m;
	curdef←-1;
	end;

procedure processcon # call this when the character after a constant was scanned;
begin if op=0 then accum←val else if op="+" then accum←accum+val else
if op="-" then accum←accum-val;
if c="+" or c="-" then
	begin state←const; op←c;
	end
else if defplace>0 then
	begin eq[defplace]←accum; state←skipcr;
	end
else	begin texte←texte&cvs(accum); state←normal;
	end;
end;

procedure finishid # used when leaving ident state;
begin if op then texte←texte&cvs(accum)&op;
if defplace>0 then error("Undefined constant.");
state←normal;
end;
comment Phase 1;

initio # initialize the input/output system;
nstrs←conroot←titlroot←0 # initialize the search trees;
m←0 # initialize the instruction list;
txtptr←0 # initialize the list of stored texts;

inbuf←""; pageno←0; state←normal; texte←""; curdef←-1; brchar←'14;
parptr←0; level[0]←-100000; curlev←0;
print("(",inputfile);

while true do
	begin label scan # go here to scan a character without reading a new one;
	if c='12 then lineno←lineno+1;
	comment The next lines read one character of input;
	while inbuf=0 do
		begin if brchar='14 then
			begin pageno←pageno+1; lineno←1; print(" ",pageno);
			end;
		inbuf←input(ichan,1);
		if eof and inbuf=0 then go to phase2;
		if pageno=1 and lineno=1 and equ(inbuf[1 to 9],"COMMENT ⊗") then
			begin comment Skip TVedit directory page;
			while brchar≠'14 and not eof do inbuf←input(ichan,1);
			if eof then go to phase2;
			inbuf←"";
			end;
		end;
	c←lop(inbuf);
scan:	case state+chartype[c] of begin
	[normal+lf] begin state←normal1; texte←texte&c end;
	[normal+lbrace] begin bal←1; state←title1; tlineno←lineno end;
	[normal+rbrace] begin error("Extra }."); texte←texte&c end;
	[normal+letter] begin id←c; state←ident; defplace←0; op←0 end;
	[normal+space][normal+cr][normal+ff][normal+digit][normal+apost]
	[normal+plus][normal+minus][normal+colon][normal+equals]
	[normal+other] texte←texte&c;
	[normal+hash] begin if texte then storetext; compile(inspar,0) end;
	[normal+lpren] begin if curlev≠level[parptr] then texte←texte&c;
	curlev←curlev+1 end;
	[normal+rpren] begin curlev←curlev-1; if curlev≠level[parptr] then
	texte←texte&c else begin if texte then storetext;
	compile(call,caller[parptr]); parptr←parptr-1 end end;
	[normal1+cr][normal1+ff] begin finishdef; state←skipcr end;
	[normal1+space][normal1+lf][normal1+letter][normal1+digit][normal1+apost]
	[normal1+plus][normal1+minus][normal1+colon][normal1+equals][normal1+lbrace]
	[normal1+rbrace][normal1+lpren][normal1+rpren][normal1+hash][normal1+other]
	begin state←normal; go to scan end;
	[title1+lbrace] state←skipcomment;
	[title1+space][title1+lf][title1+cr][title1+ff][title1+letter]
	[title1+digit][title1+apost][title1+plus][title1+minus][title1+colon]
	[title1+equals][title1+rbrace][title1+lpren][title1+rpren][title1+hash]
	[title1+other] begin if texte then storetext;
	state←skipspaces; deftype←0; go to scan end;
	[skipspaces+ff][skipcomment+ff][title2+ff] begin state←normal;
	error("Runaway commment (not complete at end of page), see line ");
	print(tlineno,"."); texte←c end;
	[skipcomment+lbrace] begin bal←bal+1; lastc←c end;
	[skipcomment+rbrace] begin bal←bal-1; if bal<0 then
	begin if lastc≠c then error("Comment didn't end with }}.");
	state←skipcr end else lastc←c end;
	[skipcomment+space][skipcomment+lf][skipcomment+cr][skipcomment+letter]
	[skipcomment+digit][skipcomment+apost][skipcomment+plus][skipcomment+minus]
	[skipcomment+colon][skipcomment+equals][skipcomment+lpren]
	[skipcomment+rpren][skipcomment+hash][skipcomment+other] lastc←c;
	[skipspaces+letter][skipspaces+digit][skipspaces+apost][skipspaces+plus]
	[skipspaces+minus][skipspaces+equals][skipspaces+lbrace][skipspaces+rbrace]
	[skipspaces+colon][skipspaces+lpren][skipspaces+rpren][skipspaces+hash]
	[skipspaces+other] begin state←title2; go to scan end;
	[title2+space][title2+cr] begin texte←texte&" "; state←skipspaces end;
	[title2+lbrace] begin texte←texte&c; bal←bal+1 end;
	[title2+rbrace] begin bal←bal-1; if bal=0 then begin state←title3;
	if texte[∞ to ∞]=" " then texte←texte[1 to ∞-1] # remove final space;
	end else texte←texte&c end;
	[title2+lf][title2+letter][title2+digit][title2+apost][title2+plus]
	[title2+minus][title2+colon][title2+equals][title2+lpren][title2+rpren]
	[title2+hash][title2+other] texte←texte&c;
	[title3+plus] deftype←1;
	[title3+colon] deftype←2;
	[title3+hash] deftype←3;
	[title3+minus] deftype←4;
	[title3+equals] startdef # Title definition found;
	[title3+lf][title3+cr][title3+ff][title3+letter][title3+digit]
	[title3+apost][title3+lbrace][title3+rbrace][title3+lpren]
	[title3+rpren][title3+other] begin comment Title use found;
	compile(call,find(texte,0)); if deftype=3 then begin compile(inspar,0);
	texte←"" end else texte←case deftype of ("","+",":","#","-");
	state←normal; go to scan end;
	[const+letter] begin id←c; state←ident end;
	[const+apost] radix←8;
	[const+digit] begin val←c-"0"; state←const1 end;
	[const+ff][const+plus][const+minus][const+colon][const+equals]
	[const+lbrace][const+rbrace][const+lpren][const+rpren][const+hash]
	[const+other] begin if defplace then
	error("Improper constant.") else texte←texte&cvs(accum)&op;
	state←normal; go to scan end;
	[const1+digit] val←radix*val+c-"0";
	[const1+space][const1+lf][const1+cr][const1+ff][const1+letter]
	[const1+apost][const1+plus][const1+minus][const1+colon][const1+equals]
	[const1+lbrace][const1+rbrace][const1+lpren][const1+rpren][const1+hash]
	[const1+other] begin processcon;
	if state≠const then go to scan end;
	[ident+letter][ident+digit] id←id&c;
	[ident+space][ident+lf][ident+cr][ident+ff][ident+apost][ident+plus]
	[ident+minus][ident+colon][ident+equals][ident+lbrace][ident+rbrace]
	[ident+lpren][ident+rpren][ident+hash][ident+other] begin integer k;
	k←find(id,2); if k then begin val←eq[k]; if val<0 then
		begin comment macro call;
		finishid;
		if texte then storetext;
		compile(begpar,0);
		if chartype[c]=lpren then
			begin comment macro with a parameter;
			if parptr≥parsize then overflow("parsize");
			parptr←parptr+1; level[parptr]←curlev;
			caller[parptr]←k;
			end
		else compile(call,k);
		go to scan;
		end
	else	begin processcon; if state≠const then go to scan
		end end
	else begin finishid; texte←texte&id; go to scan end end;
	[skipcr+lf] state←normal1;
	[skipcr+letter][skipcr+digit][skipcr+apost][skipcr+plus]
	[skipcr+minus][skipcr+colon][skipcr+equals][skipcr+lbrace][skipcr+rbrace]
	[skipcr+lpren][skipcr+rpren][skipcr+hash][skipcr+other]
	begin state←normal; go to scan end;
	else comment do nothing;
	  end;
	end;
comment Phase 2;

comment This code uses a dirty trick to keep track of the current stack of
subroutine calls. Namely, it stores links in the op-code fields of the active
call instructions;

phase2: print(")"); release(ichan);
if texte then storetext;
if state=normal1 then
	begin if m≥instrsize then m←instrsize-1; finishdef;
	end
else if state≠normal then print(nextline,"Input ended unexpectedly.");
instr[m]←exit lsh 18 # This instruction will cause phase 2 to end;
lastm←m;
m←0; stack←parptr←pparptr←0; par[0]←"";
while true do case opc(m) of begin
	[txt] begin if pparptr then ppar[pparptr]←ppar[pparptr]&texts[addr(m)]
	else out(ochan,texts[addr(m)]); m←m+1 end;
	[jmp] m←addr(m);
	[call] begin integer k; k←addr(m); if k=0 then m←m+1 else
	if eq[k] then begin instr[m]←k+((stack+10)lsh 18);
	stack←m; m←eq[k]; if m<0 then
		begin m←-m; if parptr=parsize then overflow2("parsize");
		parptr←parptr+1; par[parptr]←ppar[pparptr]; pparptr←pparptr-1;
		end;
	end else begin eq[m]←lastm; print(nextline,
	"Undefined title: {", str[k]); m←m+1 end end;
	[begpar] begin if pparptr=parsize then overflow2("pparsize");
	pparptr←pparptr+1; ppar[pparptr]←""; m←m+1 end;
	[inspar] begin if pparptr then ppar[pparptr]←ppar[pparptr]&par[parptr]
	else out(ochan,par[parptr]); m←m+1 end;
	[exit] begin integer k,l; if stack=0 then done; k←opc(stack)-10;
	l←addr(stack); if eq[l]<0 then parptr←parptr-1;
	instr[stack]←(call lsh 18)+l; m←stack+1; stack←k end;
	else begin print(nextline,"Infinite recursive call of {",str[addr(m)],
	nextline,"Can't continue."); done end
	  end;

finalend: release(ochan);
end